原标题：快速核对两列数据差异 (VBA)

我们今天和大家分享的内容是如何用VBA代码查询两列数据差异。

打个响指，举个栗子。

如上图所示，查询A列和C列的数据，提取出相同值、A列存在C列不存在的值、A列不存在C列存在的值……

查询结果如下图所示。

代码如下：

Sub CheckTwoClnData

Dim d As Object

Dim i As Long, n1 As Long, n2 As Long, n3 As Long, m As Long

Dim strTemp As String

Dim arr1 As Variant, arr2 As Variant, brr As Variant, kr As Variant

Dim rng1 As Range, rng2 As Range, rng As Range

Set d = CreateObject("ing.dictionary")

On Error Resume Next

Set rng1 = Application.InputBox("请选择需要核对差异的第一列数据", Type:=8)

'用户选取第一列数据

If rng1.Columns.Count > 1 Then MsgBox "请选择单列数据。": Exit Sub

If rng1.Rows.Count = 1 Then MsgBox "不能选择单个单元格。": Exit Sub

Set rng1 = Intersect(rng1.Parent.UsedRange, rng1)

'防止用户选取整列造成运算量虚大效率低下

If Not rng1 Is Nothing Then arr1 = rng1.Value

'将第一列数据装入arr1

Set rng2 = Application.InputBox("请选择需要核对差异的第二列数据", Type:=8)

'用户选取第二列数据

If rng2.Columns.Count > 1 Then MsgBox "请选择单列数据。": Exit Sub

If rng2.Rows.Count = 1 Then MsgBox "不能选择单个单元格。": Exit Sub

Set rng2 = Intersect(rng2.Parent.UsedRange, rng2)

If Not rng2 Is Nothing Then arr2 = rng2.Value

For i = 2 To UBound(arr1) '扣除标题行

If Len(arr1(i, 1)) Then

d("'" & arr1(i, 1)) = "不存在"

'将数据统一强制转换为字符串格式

'数据装入字典，先统一设置item为不存在

End If

Next

If UBound(arr1) > UBound(arr2) Then

'计算两列最大行数

m = UBound(arr1)

Else

m = UBound(arr2)

End If

ReDim brr(0 To m, 1 To 3)

'结果数组

'第一列放AB均存在的数据

'第二列放A有B没有的数据

'第三列放B有A没有的数据

For i = 2 To UBound(arr2)

If Len(arr2(i, 1)) Then

strTemp = "'" & arr2(i, 1)

If d.exists(strTemp) Then '如果A有B也有

n1 = n1 + 1

brr(n1, 1) = strTemp

d(strTemp) = "存在"

'将AB均有的数据item修改为存在

Else '如果B有A没有

n3 = n3 + 1

brr(n3, 3) = strTemp

End If

End If

Next

kr = d.keys

For i = 0 To UBound(kr)

If d(kr(i)) = "不存在" Then '如果A有B没有

n2 = n2 + 1

brr(n2, 2) = kr(i)

End If

Next

Err.Clear

Set rng = Application.InputBox("请选择放置查询结果的单元格，例如C1", Type:=8)

rng.Parent.Select

rng.Select

If Err.Number = 0 Then

brr(0, 1) = "两列均存在的数据有" & n1 & "条"

brr(0, 2) = "A有B没有的数据有" & n2 & "条"

brr(0, 3) = "B有A没有的数据有" & n3 & "条"

With rng(1).Resize(UBound(brr) + 1, 3)

.ClearContents '打扫房间

.NumberFormatLocal = "@"

'设置文本格式，防止文本数值变形

.Value = brr

End With

MsgBox "核对完成。" & vbLf & brr(0, 1) & vbLf & brr(0, 2) & vbLf & brr(0, 3)

End If

Set d = Nothing

Set rng = Nothing

Set rng1 = Nothing

Set rng2 = Nothing

Erase arr1: Erase arr2: Erase brr

End Sub

代码运行动画：

小贴士：

1，代码使用了字典对象，首先将第一列的数据装入字典，并将item统一设置为“不存在”，然后判断第二列的数据是否在字典中存在，如果存在，则将条目对应的item修改为“存在”，最后遍历字典，查询item仍然为“不存在”的数据。

2，代码允许用户选取整列数据，使用了Intersect方法避免运算量虚大效率低下的问题，但不允许用户选取多列或单个单元格。

3，代码无视空格，不区分文本值和数值。

图文作者：看见星光返回搜狐，查看更多

责任编辑：